COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Routines to plot performance of the multiprocessor
C00006 00003
C00010 ENDMK
C⊗;
;;; Routines to plot performance of the multiprocessor

(eval-when (load) 
	   (fasload god fas dsk (sys ml)))
(declare (special *chan* *points* *best* *scale*)
	 (setq defmacro-for-compiling ())
	 (mapex t)
	 (*lexpr line-g
		 erase-g dpyup-g)
	 (*expr ddinit-g screen-g erase-g dpyup-g))

(setq *scale* 1.0)

(defmacro tick (x y)
	  `(progn
	    (line-g ,x (+$ 1.0 yeps) ,x 1.0 1)
	    (line-g (+$ 1.0 xeps) ,y 1.0 ,y 1)))

(defun m-init-graph (&optional (points *points*) (best (float (cadar points))))
       (declare (flonum fhx fhy xeps yeps))
       (cond ((null points)
	      (terpri)
	      (princ "Not enough points")
	      (terpri))
	     (t (let ((fhx 0.0)(fhy 0.0) (xeps 0.0) (yeps 0.0))
		     (setq fhx (+$ 1.0 (float (length points))))
		     (setq fhy fhx)
		     (setq *best* best)
		     (setq *chan* -1)
		     (setq xeps (//$ fhx 100.0))
		     (setq yeps (//$ fhy 100.0))
		     (ddinit-g)
		     (screen-g 0.5 0.5 (*$ (float *scale*) fhx) 
			       (*$ (float *scale*) fhy))
		     (line-g 1.0 1.0 1.0 fhy 1)
		     (line-g 1.0 1.0 fhx 1.0 1)
		     (let ((ox (float (caar points)))
			   (oy 1.0))
			  (do ((p (cdr points) (cdr p))
			       (nx 0.0)(ny 0.0))
			      ((null p) (tick nx nx) (dpyup-g *chan*))
			      (tick nx nx)
			      (setq nx (float (caar p)))
			      (setq ny (//$ best (float (cadar p))))
			      (line-g ox oy nx ny 1)
			      (setq ox nx oy ny)))))))

(defun m-add-graph (&optional (points *points*)
			      (best (float (cadar points))))
       (declare (fixnum hx hy)(flonum fhx fhy))
       (setq *best* best)
       (cond ((null points)
	      (terpri)
	      (princ "Not enough points")
	      (terpri))
	     (t (let ((ox (float (caar points)))
		      (oy (//$ *best* (float (cadar points)))))
		     (do ((p (cdr points) (cdr p))
			  (nx 0.0)(ny 0.0))
			 ((null p) (dpyup-g *chan*))
			 (setq nx (float (caar p)))
			 (setq ny (//$ *best* (float (cadar p))))
			 (line-g ox oy nx ny 1)
			 (setq ox nx oy ny)))) ))

(defun m-reference (&optional (points *points*))
       (let ((n 0.0))
	    (m-add-graph
	     (mapcar #'(lambda (())
			       `(,(setq n (+$ 1.0 n))  
				 ,(//$ *best* n)))
		     points))))

(defun m-uninit  () ())

(defmacro tick2 (x)
	  `(progn
	    (line-g ,x yeps ,x 0.0 1)))

(defun m-init-ggraph (&optional (points *points*) (high-x 0) (high-y 0))
       (declare (fixnum hx hy)(flonum fhx fhy xeps yeps))
       (cond ((null points)
	      (terpri)
	      (princ "Not enough points")
	      (terpri))
	     (t (let ((hx 0)
		      (hy 0)(xeps 0.0)(yeps 0.0)
		      (fhx 0.0)(fhy 0.0))
		     (mapc #'(lambda (x)
				     (cond ((< hx (car x))
					    (setq hx (car x))))
				     (cond ((< hy (cadr x))
					    (setq hy (cadr x)))))
			   points)
		     (setq fhx (*$ 1.1 (float (max high-x hx)))
			   fhy (*$ 1.1 (float (max high-y hy))))
		     (setq xeps (//$ fhx 100.0))
		     (setq yeps (//$ fhy 100.0))
		     (ddinit-g)
		     (screen-g 0.0 0.0 (*$ (float *scale*) fhx) 
			       (*$ (float *scale*) fhy))
		     (line-g 0.0 0.0 0.0 fhy 1)
		     (line-g 0.0 0.0 fhx 0.0 1)
		     (let ((ox (float (caar points)))
			   (oy (float (cadar points))))
			  (tick2 ox)
			  (do ((p (cdr points) (cdr p))
			       (nx 0.0)(ny 0.0))
			      ((null p) (tick2 nx)
					(dpyup-g (cond ((boundp '*chan*) *chan*)
						       (t -1))))
			      (tick2 nx)
			      (setq nx (float (caar p)))
			      (setq ny (float (cadar p)))
			      (line-g ox oy nx ny 1)
			      (setq ox nx oy ny)))))))

(defun m-add-ggraph (&optional (points *points*))
       (declare (fixnum hx hy)(flonum fhx fhy))
       (cond ((null points)
	      (terpri)
	      (princ "Not enough points")
	      (terpri))
	     (t (let ((ox (float (caar points)))
		      (oy (float (cadar points))))
		     (do ((p (cdr points) (cdr p))
			  (nx 0.0)(ny 0.0))
			 ((null p)
			  (dpyup-g (cond ((boundp '*chan*) *chan*)
					 (t -1))))
			 (setq nx (float (caar p)))
			 (setq ny (float (cadar p)))
			 (line-g ox oy nx ny 1)
			 (setq ox nx oy ny)))))) 

(defun m-greference (&optional (points *points*))
       (let ((high (float (cadr (car points))))
	     (n 0.0))
	    (m-add-ggraph
	     (mapcar #'(lambda (x)
			       (setq n (+$ 1.0 n))
			       `(,(car x)
				 ,(//$ high
				       n)))
		     points))))